home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 1995 #5 & #6 / Amiga Plus CD - 1995 - No. 5 and 6.iso / pd / serien / purity / nr.49 / mathematik / newton.p < prev    next >
Text File  |  1995-06-24  |  3KB  |  124 lines
  1. program newtonische_interpolation;
  2.  
  3. uses crt;
  4.  
  5. type feld1 = array [1..50,1..51] of real;
  6.      feld2 = array [1..49,1..49] of real;
  7.      vektor1 = array [1..49] of real;
  8.      vektor2 = array [1..49] of real;
  9.  
  10. var i,j,n: integer;
  11.     a: feld1;
  12.     fa: feld2;
  13.     ko: vektor1;
  14.     ma: vektor2;
  15.  
  16. procedure kopf;
  17.   begin
  18.    clrscr;
  19.    writeln("*******************************************************");
  20.    writeln("*       N E W T O N I S C H E Interpolation           *");
  21.    writeln("*******************************************************");
  22.    writeln;
  23.    write(" Anzahl der Stützstellen (max.50) ? ");
  24. end;
  25.  
  26. procedure eingabe;
  27.  var i,j: integer;
  28.   begin
  29.    for i:=1 to n do begin
  30.     write(i," .x-wert, y-wert ");
  31.     for j:=1 to 2 do begin
  32.      read(a[i,j]);
  33.      write("  ");
  34.     end;
  35.    writeln;
  36.    end;
  37. end;
  38.  
  39. procedure matrix1;
  40.  var i,j,x: integer;
  41.   begin
  42.    clrscr;
  43.    for i:=1 to n do
  44.     writeln(a[i,1]:10:2,a[i,2]:10:2);
  45.     writeln("****** Matrix1 *******");
  46.     for i:=2 to n do begin
  47.      write("i= ",i,"j= ");
  48.      for j:=3 to i+1 do begin
  49.       a[i,j]:=(a[i,j-1]-a[j-2,j-1]/a[i,1]-a[j-2,1]);
  50.       write(j:3,a[i,j]:8:2," ");
  51.      end;
  52.      writeln;
  53.     end;
  54.    writeln("... weiter mit tastendruck");
  55.    waitforkey;
  56. end;
  57.  
  58. procedure matrix2;
  59.  var i,j: integer;
  60.   begin
  61.    clrscr;
  62.    writeln;
  63.    writeln("****** Matrix2 *******");
  64.    writeln;
  65.    if a[1,1]=0 then begin
  66.     for i:=1 to n-1 do fa[i,1]:=1;
  67.    end;
  68.    for i:=1 to n-1 do begin
  69.     write(fa[i,1]:10:2);
  70.     for j:=2 to i do begin
  71.      fa[i,j]:=fa[i-1,j-1]*a[i,1]-1+fa[i-1,j];
  72.      write(fa[i,j]:10:2);
  73.     end;
  74.    writeln;
  75.    end;
  76.    writeln("... weiter mit tastendruck");
  77.    waitforkey;
  78. end;
  79.  
  80. procedure koeffizienten;
  81.  var i,j: integer;
  82.   begin
  83.    writeln("Brechnung der Koeffizienten ");
  84.    for i:=1 to n-1 do ma[i]:=a[i+1,i+2];
  85.    for i:=1 to n-1 do begin
  86.     for j:=1 to n-1 do begin
  87.      writeln(j,ma[j+i-1]:10:2,fa[j+i-1,j]:10:2,ko[i]:10:2);
  88.      ko[i]:=ko[i]+ma[j+i-1]*fa[j+i-1,j];
  89.     end;
  90.     writeln("Koef ",i," = ",ko[i]:10:2);
  91.    end;
  92. end;
  93.  
  94. procedure loesung;
  95.  var i,j: integer;
  96.   begin
  97.    writeln("*********************************************");
  98.    writeln("***************  L Ö S U N G ****************");
  99.    writeln("*********************************************");
  100.    write(a[1,2]:10:2);
  101.    for i:=1 to n-1 do begin
  102.     if ko[i]>=0 then write(" + ");
  103.     write(ko[i]:10:3,"x^ ",i," ");
  104.    end;
  105.    writeln;
  106.    writeln("... weiter mit tastendruck");
  107. end;
  108.  
  109.  
  110. begin
  111.  kopf;
  112.  readln(n);
  113.  if n=0 then begin
  114.   writeln("  ## fehlerhafte eingabe ");
  115.   exit;
  116.  end;
  117.  eingabe;
  118.  matrix1;
  119.  matrix2;
  120.  koeffizienten;
  121.  loesung;
  122. end.
  123.  
  124.